Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/misc/samples2/parse.frm

Visual Basic Form | 1995-07-24 | 8.0 KB | 225 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Form1"
   ClientHeight    =   5820
   ClientLeft      =   1095
   ClientTop       =   1770
   ClientWidth     =   7365
   Height          =   6510
   Left            =   1035
   LinkTopic       =   "Form1"
   ScaleHeight     =   5820
   ScaleWidth      =   7365
   Top             =   1140
   Width           =   7485
   Begin CommandButton Command2
      Caption         =   "Create File"
      Height          =   550
      Left            =   615
      TabIndex        =   5
      Top             =   5000
      Width           =   1600
   End
   Begin CommandButton Command1
      Caption         =   "Parse File"
      Height          =   550
      Left            =   4545
      TabIndex        =   4
      Top             =   5000
      Width           =   1600
   End
   Begin TextBox Text2
      Height          =   3555
      Left            =   4110
      MultiLine       =   -1  'True
      TabIndex        =   2
      Top             =   1185
      Width           =   3120
   End
   Begin TextBox Text1
      Height          =   3555
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   1185
      Width           =   3840
   End
   Begin Label Label2
      Caption         =   "Formatted:"
      Height          =   240
      Left            =   4095
      TabIndex        =   3
      Top             =   945
      Width           =   1665
   End
   Begin Label Label1
      Caption         =   "Unformatted:"
      Height          =   255
      Left            =   135
      TabIndex        =   1
      Top             =   885
      Width           =   1605
   End
   Begin Menu mnuExit
      Caption         =   "Exit"
   End
'Dimension an array to hold each record
'read from the data file.
'You might prefer to use a dynamic area, rather
'than explicitly stating the size of the array.
Dim RecordItem(10) As String
'Declare a variable to hold the data file's name
Dim FileName As String
'Declare a variable to indicate a carriage return/line feed
Dim CRLF As String
'By dimensioning variables here, they are available to all
'procedures within the form.
Sub Command1_Click ()
    'Now that the file is created, read the contents of it into an array
    ReadDataFile
    'CRLFs have now been substituted for each comma in the string, with the
    'exception of the first comma.  Assign each record to Text2.
    For I = 1 To 10
        Text2 = Text2 + RecordItem(I)
    Next I
End Sub
Sub Command2_Click ()
    'First, we need to create a data file
    'Comment out the kind of file that you DON'T want to create
    CreateDataFile  'creates a data file WITHOUT quotation marks
    'CreateDataFileWithQuotes    'creates file WITH quotation marks
    'Now, enable the command button
    Command1.Enabled = True
End Sub
Sub CopyToArray (LineToFormat As String)
    'This routine does the actual formatting of the string and then
    'copies it to the array.  Basically all that is happening, is
    'a carriage return/line feed is being substituted for each comma
    'after the first comma is found.  You can use this same procedure
    'for substituting any character for any other character simply by
    'modifying the line containing INSTR to find the character that you
    'want to change.  Notice the similarity between finding the quotation
    'mark and finding a comma.
    'Dimension a variable for the array's index and preserve its
    'value between calls
    Static Index As Integer
    'Increment the value stored in Index
    Index = Index + 1
    'Dim a variable to hold the postion of each comma in the string
    Dim CommaPos As Integer
    'Dim a variable to hold the postion of each quotation mark in the string
    Dim QuotePos As Integer
    'Dim another variable to use as a flag for the first comma
    'This flag is initially false, after the first comma is found,
    'it is changed to true, meaning that we have already found the
    'first comma in the string
    Dim FirstComma As Integer
    'Begin loop that will parse through the string one character at a time,
    'searching for both commas and quotation marks
    For I = 1 To Len(LineToFormat)
        'Get the next character in the string
        char$ = Mid$(LineToFormat, I, 1)
        Temp$ = Temp$ + char$
        'First we'll test for quotation marks
        '34 is the ascii value for a quotation mark
        'Since all quotation marks are being removed,
        'we need to always start searching from the 1st position
        QuotePos = InStr(1, Temp$, Chr$(34))
        If QuotePos Then
            'Simply remove the last character from the string
            Temp$ = Left$(Temp$, QuotePos - 1)
        End If

        'Now test for a comma.  This is just a bit more complicated
        'because we need to skip over the first comma that is found
        '44 is the ascii value for a comma.  Because we may have removed
        'a quotation mark, we must start the search at the last
        'postion in the string
        CommaPos = InStr(Len(Temp$), Temp$, Chr$(44))
        'Change FirstComma to true only if a comma has been
        'found and the flag is false, meaning this is the first
        'time we have encountered a comma
        If CommaPos And FirstComma = False Then
            FirstComma = True
        ElseIf CommaPos And FirstComma = True Then
            'Substitute a CRLF for the last character in the string
            Temp$ = Left$(Temp$, CommaPos - 1) + CRLF
        End If
    Next I
    'Assign the temp string to the array and append 2 more CRLFs
    RecordItem(Index) = Temp$ + CRLF + CRLF
End Sub
Sub CreateDataFile ()
    'Creates a data file which does NOT contain quotation marks.
    'The commas need to be a part of the string that is written.
    Item1$ = "Doe, John,555-1435,Thrillseeker"
    Item2$ = "Doe, Jane,555-7899,couch potato"
    FileNum = FreeFile
    FileName = App.Path + "\datafile.dat"
    Open FileName For Output As FileNum
    Print #FileNum, Item1$
    Print #FileNum, Item2$
    Close FileNum
End Sub
Sub CreateDataFileWithQuotes ()
    'Creates a data file which DOES contain quotation marks.
    'The commas need to be a part of the string that is written.
    Item1a$ = "Doe, John"
    Item1b$ = "555 - 1435"
    Item1c$ = "Thrillseeker"
    Item2a$ = "Doe, Jane"
    Item2b$ = "555-7899"
    Item2c$ = "couch potato"
    FileNum = FreeFile
    FileName = App.Path + "\datafile.dat"
    Open FileName For Output As FileNum
    Write #FileNum, Item1a$, Item1b$, Item1c$
    Write #FileNum, Item2a$, Item2b$, Item2c$
    Close FileNum
End Sub
Sub Form_Load ()
'******************************************************************
'Original message
'Example
'CSV Format
'"Doe, John","555-1435","Thrillseeker"
'"Doe, Jane","555-7899","couch potato"
'convert to
'Doe, John
'555-1435
'Thrillseeker
'Doe, Jane
'555-7899
'Couchpotato
'******************************************************************
    'Define a carriage return/line feed
    CRLF = Chr$(13) + Chr$(10)
    'Disable the command button until after the file
    'has been created.
    Command1.Enabled = False
End Sub
Sub Form_Unload (Cancel As Integer)
    End
End Sub
Sub mnuExit_Click ()
    Unload Me
End Sub
Sub ReadDataFile ()
    'Reads each line of the data file and places it into
    'an array named RecordItem.
    FileNum = FreeFile
    Open FileName For Input As FileNum
    I = 1
    Do Until EOF(FileNum)
        Line Input #FileNum, A$
        'Write each record, as it appears in the data file
        'to the first text box
        Text1 = Text1 + A$ + CRLF
        'Now call the procedure to format the string and
        'copy it to the array, passing the string to the procedure
        CopyToArray A$
        I = I + 1
    Loop
    Close FileNum
End Sub